;;;    $Id, lt-preferences.scm $
;;;
;;;    lambda-tube (λ-tube) - A youtube search API and application in scheme.
;;;    Copyright (C) 2008  Abhishek Mishra
;;;
;;;    This program is free software: you can redistribute it and/or modify
;;;    it under the terms of the GNU General Public License as published by
;;;    the Free Software Foundation, either version 3 of the License, or
;;;    (at your option) any later version.

;;;    This program is distributed in the hope that it will be useful,
;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;    GNU General Public License for more details.

;;;    You should have received a copy of the GNU General Public License
;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.

;A utility module providing methods to store and access preferences
;Also the preferences dialog is defined here.
(module lt-preferences mzscheme
  (require 
   "lt-app-details.scm"
   (lib "class.ss")
   "lt-app-details.scm")
  (provide get-home-folder 
           get-prefs-folder-name 
           get-prefs-file-name 
           get-prefs 
           get-prefs-dialog
           initial-setup-required?
           initial-setup
           lt-prefs%
           thumbnail-cache-folder-param
           video-cache-folder-param
           results-per-page-param
           show-images?-param
           show-comments?-param
           save-history?-param
           history-size-param
           media-player-param
           language-param
           http-proxy-details-param
           play-video-on-download?-param
           download-format-param
           get-history-file-name
           get-lt-home
           get-lt-i18n-folder
           get-host-for-proxy
           get-port-for-proxy
           construct-proxy
           is-proxy-enabled?
           *formats-list*
           get-format-name
           get-format-value
           get-format-by-name)
  
  ;param names
  (define thumbnail-cache-folder-param "thumbnail-cache-folder")
  (define video-cache-folder-param "video-cache-folder")
  (define results-per-page-param "results-per-page")
  (define show-images?-param "show-images?")
  (define show-comments?-param "show-comments?")
  (define save-history?-param "save-history")
  (define history-size-param "history-size")
  (define media-player-param "media-player")
  (define language-param "language")
  (define http-proxy-details-param "http-proxy-details")
  (define play-video-on-download?-param "play-video-on-download?")
  (define download-format-param "download-format")
  
  ; All the supported formats
  (define *formats-list* (list (list "DEFAULT_FORMAT" "") (list "MOBILE_FORMAT" "17") (list "HD_FORMAT" "22")))
  
  ; Get the format name from a format
  (define (get-format-name format)
    (car format))
  
  ; Get the format value from a format
  (define (get-format-value format)
    (cadr format))
  
  ; Get the format given its name
  (define (get-format-by-name name)
    (define (get-format formats fn)
      (if (eq? formats '())
          #f
          (begin
            (let* ((current-format (car formats))
                   (current-format-name (get-format-name current-format)))
              (if (equal? current-format-name fn)
                  current-format
                  (get-format (cdr formats) fn))))))
    (get-format *formats-list* name))
  
  ;creates a new param/value pair
  (define (create-param param-name param-value)
    (cons param-name param-value))
  
  ;get a param from prefs list
  (define (get-param-value prefs param-name)
    (if (eq? prefs '())
        '()
        (let ((pname (caar prefs)))
          (if (equal? pname param-name)
              (cdar prefs)
              (get-param-value (cdr prefs) param-name)))))
  
  ;set a param to the prefs list
  (define (set-param-value prefs param-name param-value)
    (if (eq? (get-param-value prefs param-name) '())
        (append prefs (list (create-param param-name param-value)))
        (update-param prefs param-name param-value)))
  
  ;updates value of a parameter in a prefs list and returns the updated list
  ;(define (update-param prefs param-name param-value)
  ;  (let ((pname (caar prefs)))
  ;    (if (equal? pname param-name)
  ;        (begin
  ;          (set-cdr! (car prefs) param-value)
  ;          prefs)
  ;        (cons (car prefs) (update-param (cdr prefs) param-name param-value)))))
  
  ;updates value of a parameter in a prefs list and returns the updated list
  (define (update-param prefs param-name param-value)
    (let ((nprefs (up prefs param-name param-value '())))
      nprefs ))
  
  (define (up prefs param-name param-value new-prefs)
    (if (eq? prefs '())
        new-prefs
        (let ((pname (caar prefs)))
          (if (equal? pname param-name)
              (up (cdr prefs) param-name param-value (cons (cons param-name param-value) new-prefs))
              (up (cdr prefs) param-name param-value (cons (car prefs) new-prefs))))))
  
  
  ;preferences class
  (define lt-prefs% 
    (class object%
      (super-new)
      
      ;preferences
      (define prefs '())
      
      ;get prefs
      (define/public (get-prefs)
        prefs)
      
      ;save preferences to file.
      (define/public (save-prefs)
        (let ((prefs-fname (get-prefs-file-name)))
          (if (file-exists? prefs-fname)
              (delete-file prefs-fname))
          (with-output-to-file (path->string (get-prefs-file-name)) (lambda () (write prefs)))))
      
      ;just loads the default values.
      (define/public (load-default-values)
        (set-param thumbnail-cache-folder-param (path->string (get-temp-folder)))
        (set-param video-cache-folder-param (path->string (get-videos-folder-name (get-prefs-folder-name))))
        (set-param results-per-page-param "2")
        (set-param show-images?-param "#t")
        (set-param media-player-param "vlc")
        (set-param language-param "English(US)")
        (set-param http-proxy-details-param (construct-proxy "localhost" "3128" #f))
        (set-param download-format-param "DEFAULT_FORMAT"))
      
      ;loads the current values from the preference file.
      (define/public (load-values-from-file file-name)
        (with-input-from-file file-name
          (lambda () (set! prefs (read)))))
      
      ;loads values from the preferences file.
      (define/public (load-values)
        (load-values-from-file (path->string (get-prefs-file-name))))
      ;get param value
      (define/public (get-param pname)
        (let ((pval (get-param-value prefs pname)))
          (if (eq? pval '())
              (begin 
                (cond ((string=? pname thumbnail-cache-folder-param) (set-param thumbnail-cache-folder-param (path->string (get-temp-folder))))
                      ((string=? pname video-cache-folder-param) (set-param video-cache-folder-param (path->string (get-videos-folder-name (get-prefs-folder-name)))))
                      ((string=? pname results-per-page-param) (set-param results-per-page-param "3"))
                      ((string=? pname show-images?-param) (set-param show-images?-param "#t"))
                      ((string=? pname show-comments?-param) (set-param show-comments?-param "#t"))
                      ((string=? pname save-history?-param) (set-param save-history?-param "#t"))
                      ((string=? pname play-video-on-download?-param) (set-param play-video-on-download?-param #f))
                      ((string=? pname history-size-param) (set-param history-size-param "5"))
                      ((string=? pname media-player-param) (set-param media-player-param "vlc"))
                      ((string=? pname language-param) (set-param language-param "English(US)"))
                      ((string=? pname http-proxy-details-param) (set-param http-proxy-details-param (construct-proxy "localhost" "3128" #f)))
                      ((string=? pname download-format-param) (set-param download-format-param "DEFAULT_FORMAT")))
                (save-prefs)
                (load-values)
                (get-param-value prefs pname))
              pval)))
      
      ;set param value
      (define/public (set-param pname value)
        (set! prefs (set-param-value prefs pname value)))
      
      ;read a param line and load the param
      ))
  
  ;define system type
  (define sys-type (system-type))
  
  ;get home folder for current user
  (define (get-home-folder)
    (if (eq? sys-type 'unix) 
        (getenv "HOME")
        (if (eq? sys-type 'windows) 
            (getenv "APPDATA"))))
  
  ;get temp folder
  (define (get-temp-folder)
    (if (eq? sys-type 'unix) 
        (build-path "/tmp" app-name-on-disk (getenv "USER"))
        (if (eq? sys-type 'windows) 
            (build-path (getenv "TMP") (getenv "USERNAME")))))
  
  ;get the prefs folder name
  (define (get-prefs-folder-name)
    (build-path (get-home-folder) (string-append "." app-name-on-disk)))
  
  ;get the videos folder name
  (define (get-videos-folder-name prefs-folder)
    (build-path prefs-folder "videos"))
  
  ;get the prefs file name
  (define (get-prefs-file-name)
    (build-path (get-prefs-folder-name) (string-append app-name-on-disk "-prefs")))
  
  ;get the history file name
  (define (get-history-file-name)
    (build-path (get-prefs-folder-name) (string-append app-name-on-disk "-history")))
  
  ;checks if initial setup is required.
  (define (initial-setup-required?)
    (not (and (directory-exists? (get-prefs-folder-name)) (file-exists? (get-prefs-file-name)))))
  
  ;gets the lambda-tube install folder
  (define (get-lt-home)
    (let ((lt-executable (find-system-path 'run-file)))
      (let-values ([(base fname dir?) (split-path lt-executable)])
        (cond ((eq? sys-type 'unix)
               (if (equal? (path->string fname) "drscheme")
                   (build-path (current-load-relative-directory) 'up)
                   (build-path base 'up)))
              ((eq? sys-type 'windows)
               (if (equal? (path->string fname) "DrScheme.exe")
                   (build-path (current-load-relative-directory) 'up)
                   (build-path lt-executable 'up)))))))
  
  ;gets the i18n folder
  (define (get-lt-i18n-folder)
    (build-path (get-lt-home) "i18n"))
  
  (define (get-prefs) #t)
  (define (get-prefs-dialog) #t)
  
  ;a helper class to do the initial setup for the first run,
  ;or if the config folder is deleted.
  (define (initial-setup)
    (if (not (directory-exists? (get-prefs-folder-name)))
        (make-directory (get-prefs-folder-name)))
    (if (not (directory-exists? (get-temp-folder)))
        (make-directory (get-temp-folder)))
    (let ((prefs (new lt-prefs%)))
      (send prefs load-default-values)
      (send prefs save-prefs)
      )
    )
  
  ;get the hostname from proxy
  (define (get-host-for-proxy proxy)
    (car proxy))
  
  ;get the port from the proxy
  (define (get-port-for-proxy proxy)
    (cadr proxy))
  
  ;tests whether proxy is enabled
  (define (is-proxy-enabled? proxy)
    (caddr proxy))
  
  ;construct a proxy
  (define (construct-proxy server port use?)
    (list server port use?))
  
  )